home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1996 November: Tool Chest / Dev.CD Nov 96 TC / Dev.CD Nov 96 TC.toast / Tool Chest / Development Tools & Languages / HyperCard Related / APDA HyperCard Toolkits / HyperCard Video Toolkit 2.0 / HVT #2 / Advanced Material / Video Sources / videoPlayers.p < prev    next >
Encoding:
Text File  |  1995-02-07  |  4.4 KB  |  166 lines  |  [TEXT/MPS ]
  1. (*
  2.     videoPlayers() -- Return a list of the valid videodisc player names.
  3.  
  4.     To compile and link this file using Macintosh Programmer's Workshop,
  5.  
  6.         pascal -w videoPlayers.p
  7.  
  8.         link -m ENTRYPOINT -o HyperCommands -rt XFCN=8003 -sn Main=videoPlayers ∂
  9.             videoPlayers.p.o "{MPW}"Libraries:interface.o "{MPW}"PLibraries:PasLib.o
  10.  
  11.     Copyright © 1988 Apple Computer, Inc.
  12.  
  13.     2/88 - Initial coding by Harry R. Chesley.
  14. *)
  15.  
  16. {$R-}
  17.  
  18. {$S videoPlayers }     { Segment name must be the same as the command name. }
  19.  
  20. unit DummyUnit;
  21.  
  22. interface
  23.  
  24. uses MemTypes, QuickDraw, OSIntf, ToolIntf, HyperXCmd;
  25.  
  26. procedure EntryPoint(paramPtr: XCmdPtr);
  27.     
  28. implementation
  29.  
  30. type
  31.  
  32. Str31 = String[31];
  33.  
  34. procedure videoPlayers(paramPtr: XCmdPtr); forward;
  35.  
  36. procedure EntryPoint(paramPtr: XCmdPtr);
  37.  
  38.     begin
  39.         videoPlayers(paramPtr);
  40.     end;
  41.  
  42. procedure videoPlayers(paramPtr: XCmdPtr);
  43.  
  44.     var resHandle: Handle;            { Driver resource handle. }
  45.         resID: integer;                    { Driver resource ID. }
  46.         resType: ResType;            { Driver resource type. }
  47.         resName: str255;                { Driver resource name. }
  48.         i: integer;
  49.         thePlayers: Handle;            { List of players. }
  50.         oldSize, nextNameOffset, playersSize: longInt;
  51.         newName: str255;
  52.         playerXFCN: str255;        { Player driver name. }
  53.         theNames: Handle;            { List of names. }
  54.         p, p2: Ptr;
  55.         lastChar: SignedByte;
  56.         str: str255;
  57.  
  58.     {$I XCmdGlue.inc}
  59.  
  60.     procedure Fail(errMsg: Str255); { set theResult and quit }
  61.         begin
  62.             paramPtr^.returnValue := PasToZero(errMsg);
  63.             exit(videoPlayers);
  64.         end;
  65.  
  66.     procedure FailWithPlayers(err: str255);
  67.         begin
  68.             DisposHandle(thePlayers);
  69.             Fail(err);
  70.         end;
  71.  
  72.     procedure FailWithNames(err: str255);
  73.         begin
  74.             DisposHandle(theNames);
  75.             FailWithPlayers(err);
  76.         end;
  77.  
  78.     {$I VideoUtil.inc}
  79.  
  80.     begin
  81.         if paramPtr^.paramCount <> 0 then Fail('parameter count is not 0');
  82.  
  83.         { Get any HyperTalk drivers. }
  84.         thePlayers := GetGlobal('videoHTPlayers');
  85.         if thePlayers = nil then thePlayers := NewHandle(0)
  86.         else
  87.             begin
  88.                 { Cycle thru all the names. }
  89.                 playersSize :=0;
  90.                 p := Ptr(ord4(thePlayers^)-1);
  91.                 p2 := Ptr(ord4(p)+1);
  92.                 repeat
  93.                     { Add a short name to the player list. }
  94.                     playersSize := playersSize+1;
  95.                     p := Ptr(ord4(p)+1);
  96.                     lastChar := p^;
  97.                     { End of item? }
  98.                     if (lastChar = ord(',')) or (lastChar = 0) then
  99.                         begin
  100.                             { If yes, then convert it to a Pascal item in place (more or less). }
  101.                             p^ := 0;
  102.                             ZeroToPas(p2,str);
  103.                             BlockMove(@str,p2,ord4(p)-ord4(p2)+1);
  104.                             p2 := Ptr(ord4(p)+1);
  105.                         end;
  106.                 until lastChar = 0;
  107.                 if playersSize > GetHandleSize(thePlayers) then FailWithPlayers('bad videoHTPlayers global');
  108.                 SetHandleSize(thePlayers,playersSize);
  109.             end;
  110.  
  111.         { Add in all the XFCN drivers. }
  112.         for i := 1 to CountResources('XFCN') do
  113.             begin
  114.                 resHandle := GetIndResource('XFCN',i);
  115.                 GetResInfo(resHandle,resID,resType,resName);
  116.                 if length(resName) > 7 then
  117.                     if StringEqual(Copy(resName,1,7),'vidDrvr') then
  118.                         begin
  119.                             resName := Copy(resName,8,length(resName)-7);
  120.                             oldSize := GetHandleSize(thePlayers);
  121.                             SetHandleSize(thePlayers,oldSize+length(resName)+1);
  122.                             if MemError <> noErr then FailWithPlayers('out of memory');
  123.                             BlockMove(@resName,Ptr(ord4(thePlayers^)+oldSize),length(resName)+1);
  124.                         end;
  125.             end;
  126.  
  127.         { Now convert to the long names. }
  128.         theNames := NewHandle(5);
  129.         if MemError <> noErr then FailWithPlayers('out of memory');
  130.         { Start with a list with "None" in it. }
  131.         str := 'None,';
  132.         BlockMove(Ptr(ord4(@str)+1),theNames^,5);
  133.         { Cycle thru all the drivers available. }
  134.         playersSize := GetHandleSize(thePlayers);
  135.         nextNameOffset := 0;
  136.         while nextNameOffset < playersSize do
  137.             begin
  138.                 BlockMove(ptr(ord4(thePlayers^)+nextNameOffset),@playerXFCN,sizeOf(playerXFCN));
  139.                 if playerXFCN <> '' then
  140.                     begin
  141.                         { Get the long name for the driver. }
  142.                         newName := Concat(EvalStr(Concat('vidDrvr',playerXFCN,'(name)')),',');
  143.                         if newName <> '' then
  144.                             begin
  145.                                 oldSize := GetHandleSize(theNames);
  146.                                 SetHandleSize(theNames,oldSize + length(newName));
  147.                                 if MemError <> noErr then FailWithNames('out of memory');
  148.                                 BlockMove(ptr(ord4(@newName)+1),ptr(ord4(theNames^)+oldSize),length(newName));
  149.                             end;
  150.                     end;
  151.                 nextNameOffset := nextNameOffset + length(playerXFCN) + 1;
  152.             end;
  153.  
  154.         { Now zero-terminate the names. }
  155.         p := Ptr(ord4(theNames^)+GetHandleSize(theNames)-1);
  156.         p^ := 0;    { Write over the last comma. }
  157.  
  158.         { Free the short names. }
  159.         DisposHandle(thePlayers);
  160.  
  161.         { Return the long name list. }
  162.         paramPtr^.returnValue := theNames;
  163.     end;
  164.  
  165. end.
  166.